home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Decision Cube / mxdssqry.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  33KB  |  1,316 lines

  1. {*******************************************************}
  2. {                                                       }
  3. {       Borland Delphi Visual Component Library         }
  4. {                                                       }
  5. {       Copyright (c) 1997,99 Inprise Corporation       }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit mxdssqry;
  10.  
  11. interface
  12.  
  13. uses
  14.  Windows, Messages, SysUtils, Classes, Dialogs, Controls, StdCtrls, Graphics,
  15.  DB, dbtables, Grids, forms, ExtCtrls, Buttons, ComCtrls, Menus,
  16.  mxConsts, mxgrid, mxdb, mxcommon, mxstore, mxtables, mxqparse;
  17.  
  18. type
  19.   ECubeDesignError = class(Exception);
  20.   EAddWarning = class(Exception);
  21.   EAddError = class(Exception);
  22.  
  23.   TDSSQueryEditor = class(TForm)
  24.     FieldList: TListBox;
  25.     ActiveDimList: TListBox;
  26.     SummaryList: TListBox;
  27.     Label2: TLabel;
  28.     Label3: TLabel;
  29.     ShowBox: TMemo;
  30.     AggPopup: TPopupMenu;
  31.     Cancel: TBitBtn;
  32.     CancelQryMod: TButton;
  33.     count1: TMenuItem;
  34.     count2: TMenuItem;
  35.     EditQry: TButton;
  36.     VQB: TButton;
  37.     SelectAllFields: TButton;
  38.     Label4: TLabel;
  39.     OKButton: TButton;
  40.     average1: TMenuItem;
  41.     HelpButton: TButton;
  42.     Pager: TPageControl;
  43.     Dimensions: TTabSheet;
  44.     Query: TTabSheet;
  45.     Label1: TLabel;
  46.     TableCombo: TComboBox;
  47.     DatabaseCombo: TComboBox;
  48.     Label5: TLabel;
  49.     Label6: TLabel;
  50.     AddButton: TBitBtn;
  51.     AddAgg: TBitBtn;
  52.     RemoveButton: TBitBtn;
  53.     RemoveAgg: TBitBtn;
  54.     Label7: TLabel;
  55.     CountStarAvg: TCheckBox;
  56.     procedure AddButtonClick(Sender: TObject);
  57.     procedure RemoveButtonClick(Sender: TObject);
  58.     procedure FieldListClick(Sender: TObject);
  59.     procedure ActiveDimListClick(Sender: TObject);
  60.     procedure SummaryListClick(Sender: TObject);
  61.     procedure AddAggClick(Sender: TObject);
  62.     procedure RemoveAggClick(Sender: TObject);
  63.     procedure Sum1Click(Sender: TObject);
  64.     procedure Count1Click(Sender: TObject);
  65.     procedure OKButtonClick(Sender: TObject);
  66.     procedure CancelQryModClick(Sender: TObject);
  67.     procedure ShowBoxChange(Sender: TObject);
  68.     procedure EditQryClick(Sender: TObject);
  69.     procedure VQBClick(Sender: TObject);
  70.     procedure SelectAllFieldsClick(Sender: TObject);
  71.     procedure FieldListDblClick(Sender: TObject);
  72.     procedure average1Click(Sender: TObject);
  73.     procedure ActiveDimListDragDrop(Sender, Source: TObject; X,
  74.       Y: Integer);
  75.     procedure ActiveDimListDragOver(Sender, Source: TObject; X, Y: Integer;
  76.       State: TDragState; var Accept: Boolean);
  77.     procedure FieldListDragOver(Sender, Source: TObject; X, Y: Integer;
  78.       State: TDragState; var Accept: Boolean);
  79.     procedure SummaryListDragOver(Sender, Source: TObject; X, Y: Integer;
  80.       State: TDragState; var Accept: Boolean);
  81.     procedure FieldListDragDrop(Sender, Source: TObject; X, Y: Integer);
  82.     procedure SummaryListDragDrop(Sender, Source: TObject; X, Y: Integer);
  83.     procedure FieldListKeyPress(Sender: TObject; var Key: Char);
  84.     procedure ShowBoxKeyPress(Sender: TObject; var Key: Char);
  85.     procedure ActiveDimListKeyPress(Sender: TObject; var Key: Char);
  86.     procedure SummaryListKeyPress(Sender: TObject; var Key: Char);
  87.     procedure PagerChanging(Sender: TObject;
  88.       var AllowChange: Boolean);
  89.     procedure TableComboChange(Sender: TObject);
  90.     procedure DatabaseComboChange(Sender: TObject);
  91.     procedure DatabaseComboExit(Sender: TObject);
  92.     procedure DatabaseComboKeyPress(Sender: TObject; var Key: Char);
  93.     procedure TableComboKeyPress(Sender: TObject; var Key: Char);
  94.     procedure TableComboExit(Sender: TObject);
  95.     procedure HelpButtonClick(Sender: TObject);
  96.     procedure DatabaseComboKeyDown(Sender: TObject; var Key: Word;
  97.       Shift: TShiftState);
  98.     procedure TableComboKeyDown(Sender: TObject; var Key: Word;
  99.       Shift: TShiftState);
  100.     procedure CountStarAvgClick(Sender: TObject);
  101.     { Private declarations }
  102.   private
  103.     bEditEnabled: Boolean;
  104.     bisOK: Boolean;
  105.     bQueryLegal: Boolean;
  106.     bAllFields: Boolean;
  107.     bDataBaseEditing: Boolean;
  108.     bDataBaseChanged: Boolean;
  109.     bTableNameEditing: Boolean;
  110.     bTableNameChanged: Boolean;
  111.     bQueryEditing: Boolean;
  112.     bSQLChangeOff: Boolean;
  113.     bStarAvgChanging: Boolean;
  114.     myMap: TQueryDims;
  115.     fieldMap: TQueryDims;
  116.     myQuery: TQuery;
  117.     vqbQuery: TQuery;
  118.     myDB: TDataBase;
  119.     mySQL: String;
  120.     myAlias: String;
  121.     fQParse: TXtabQuery;
  122.     procedure SetQueryEditState(State: Boolean);
  123.     procedure ListBoxUnSelect(aListBox: TListBox);
  124.     function AddNewItem(sType: TDimFlags; DM: TQueryDim; Name: string): Boolean;
  125.     function AddSummary(sType: TDimFlags): Boolean;
  126.     procedure AddCountStar;
  127.     procedure RemoveCountStar;
  128.     function FieldListDisplay(Map: TQueryDim): string;
  129.     procedure ProcessNewQuery(newSQL: string);
  130.     procedure ProcessNewQueryError(newSQL: string);
  131.     procedure SetDatabaseName(tAlias: string);
  132.     procedure SetTableName(TableName: string);
  133.     procedure UpdateLists;
  134.     procedure UpdateTableList;
  135.     procedure UpdateDataBaseList;
  136.     procedure UpdateFieldList;
  137.     procedure UpdateDimLists;
  138.     procedure UpdateSQLBox;
  139.     procedure UpdateTableName;
  140.     { Protected declarations }
  141.   protected
  142.     { Public declarations }
  143.   public
  144.     function SInitialize(const Designer: IDesigner; aQuery: TQuery): Boolean;
  145.     constructor Create(AOwner: TComponent); override;
  146.     destructor Destroy; override;
  147.   end;
  148.  
  149. procedure ShowDSSQueryEditor(const Designer: IDesigner; aQuery: TQuery);
  150.  
  151. implementation
  152.  
  153. uses
  154.   GQEDelph;
  155.  
  156. {$R *.DFM}
  157.  
  158.  
  159.   { Query Editor }
  160.  
  161. procedure ShowDSSQueryEditor(const Designer: IDesigner; aQuery: TQuery);
  162. var
  163.   aWindow: TDSSQueryEditor;
  164.   x, y: Integer;
  165. begin
  166.   if not assigned(aQuery) then Exit;
  167.   aWindow := TDSSQueryEditor.Create(application);
  168.   try
  169.     if aWindow.SInitialize(Designer, aQuery) then
  170.     begin
  171.       x := (Screen.Width - aWindow.Width) div 2;
  172.       y := (Screen.Height - aWindow.Height) div 2;
  173.       if (x < 0) then x := 0;
  174.       if (y < 0) then y := 0;
  175.       aWindow.Left := x;
  176.       aWindow.Top := y;
  177.       aWindow.ShowModal;
  178.     end;
  179.   finally
  180.     aWindow.free;
  181.   end;
  182. end;
  183.  
  184. function CheckIfStringNull(aString: string): Boolean;
  185. var
  186.   i: Integer;  
  187. begin
  188.   Result := False;
  189.   for i := 1 to length(aString) do
  190.     if (ord(aString[i]) > 32) then Exit;
  191.   Result := True;
  192. end;
  193.  
  194. constructor TDSSQueryEditor.Create(AOwner: TComponent);
  195. begin
  196.   inherited Create(AOwner);
  197. end;
  198.  
  199. destructor TDSSQueryEditor.Destroy;
  200. begin
  201.   if (myDB <> nil) then
  202.   begin
  203.     myQuery.DBSession.CloseDataBase(myDB);
  204.     myDB := nil;
  205.   end;
  206.   myMap.Free;
  207.   fieldMap.Free;
  208.   vqbQuery.Free;
  209.   fQParse.Free;
  210.   inherited Destroy;
  211. end;
  212.  
  213. function TDSSQueryEditor.SInitialize(const Designer: IDesigner; aQuery: TQuery): Boolean;
  214. begin
  215.   myQuery := aQuery;
  216.   if (not assigned(myQuery)) then
  217.   begin
  218.     raise ECubeDesignError.createRes(@sNoDataSet);
  219.     Result := False;
  220.     Exit;
  221.   end;
  222.   myMap := TQueryDims.Create(myQuery, TQueryDim);
  223.   fieldMap := TQueryDims.Create(myQuery, TQueryDim);
  224.   SetDataBaseName(myQuery.DataBaseName);  { be sure to set database before SQL }
  225.   bEditEnabled := True;
  226.   UpdateTableList;
  227.   UpdateDatabaseList;
  228.   bDataBaseEditing := False;
  229.   bTableNameEditing := False;
  230.   Pager.activePage := Dimensions;
  231.   try
  232.     bAllFields := True;
  233.     ProcessNewQuery(myQuery.SQL.text);
  234.   except
  235.     on E: exception do
  236.     begin
  237.       mySQL := myQuery.SQL.Text;
  238.       ShowMessage(E.message);
  239.       Pager.ActivePage := Query;
  240.     end;
  241.   end;
  242.   SetQueryEditState(False);
  243.   bSQLChangeOff := False;
  244.   UpdateLists;
  245.   VQB.Visible := LoadGQE;
  246.   bTableNameEditing := False;
  247.   bStarAvgChanging := False;
  248.   Result := True;
  249. end;
  250.  
  251. procedure TDSSQueryEditor.UpdateLists;
  252. begin
  253.   UpdateFieldList;
  254.   UpdateDimLists;
  255.   UpdateSQLBox;
  256. end;
  257.  
  258. procedure TDSSQueryEditor.UpdateFieldList;
  259. var
  260.   i: Integer;
  261.   DM: TQueryDim;  
  262. begin
  263.   FieldList.Clear;
  264.   for i := 0 to fieldMap.Count-1 do
  265.   begin
  266.     DM := fieldMap[i];
  267.     FieldList.Items.Add(FieldListDisplay(DM));
  268.   end;
  269.   if bAllFields then
  270.     SelectAllFields.caption := sQueryFields
  271.   else
  272.     SelectAllFields.caption := sAllFields;
  273. end;
  274.  
  275. procedure TDSSQueryEditor.UpdateDimLists;
  276. var
  277.   i: Integer;
  278.   DM: TQueryDim;
  279.   bChecked: Boolean;
  280. begin
  281.   ActiveDimList.Clear;
  282.   SummaryList.Clear;
  283.   AddButton.enabled := (Fieldlist.SelCount > 0);
  284.   AddAgg.enabled := (Fieldlist.SelCount > 0);
  285.   RemoveButton.enabled := False;
  286.   RemoveAgg.enabled := False;
  287.   bChecked := False;
  288.   for I := 0 to myMap.count-1 do
  289.   begin
  290.     DM := myMap[i];
  291.     if DM.active then
  292.     begin
  293.       if (DM.DimensionType <> dimDimension) then
  294.       begin
  295.         SummaryList.Items.Add(DM.FieldName);
  296.         if (AnsiUpperCase(DM.Name) = sCountStar) then
  297.           bChecked := True;
  298.       end
  299.       else
  300.         ActiveDimList.Items.Add(DM.FieldName);
  301.     end;
  302.   end;
  303.   bStarAvgChanging := True;
  304.   CountStarAvg.Checked := bChecked;
  305.   bStarAvgChanging := False;
  306. end;
  307.  
  308. procedure TDSSQueryEditor.UpdateSQLBox;
  309. begin
  310.   bSQLChangeOff := True;
  311.   ShowBox.Lines.Text := mySQL;
  312.   bSQLChangeOff := False;
  313. end;
  314.  
  315. procedure TDSSQueryEditor.AddButtonClick(Sender: TObject);
  316. var
  317.   i, j: Integer;
  318.   DM: TQueryDim;
  319.   bChanged: Boolean;
  320.   eWarning: string;
  321. begin
  322.   bChanged := False;
  323.   eWarning := '';
  324.   with FieldList do
  325.     for I := 0 to Items.Count - 1 do
  326.     begin
  327.       if Selected[I] then
  328.       begin
  329.         for J := 0 to fieldMap.count-1 do
  330.         begin
  331.           DM := fieldMap[J];
  332.  
  333.           if (FieldListDisplay(DM) = Items.STRINGS[I]) then
  334.           begin
  335.             try
  336.               if AddNewItem(dimDimension,DM,'') then
  337.                 bChanged := True;
  338.             except
  339.               on e: EAddWarning do
  340.               begin
  341.                 eWarning := E.message;
  342.               end;
  343.               on E: exception do
  344.               begin
  345.                 if bChanged then
  346.                 begin
  347.                   mySQL := FQParse.SQLString;
  348.                   UpdateDimLists;
  349.                   UpdateSQLBox;
  350.                 end;
  351.                 raise;
  352.               end;
  353.             end;
  354.           end;
  355.         end;
  356.       end;
  357.     end;
  358.   if bChanged then
  359.   begin
  360.     mySQL := FQParse.SQLString;
  361.     UpdateDimLists;
  362.     UpdateSQLBox;
  363.   end;
  364.   if (EWarning <> '') then
  365.     raise EAddWarning.create(EWarning);
  366. end;
  367.  
  368. procedure TDSSQueryEditor.AddAggClick(Sender: TObject);
  369. var
  370.   aPoint: TPoint;
  371. begin
  372.   aPoint.x := 0;
  373.   aPoint.y := AddAgg.Height;
  374.   aPoint := AddAgg.ClientToScreen(aPoint);
  375.   AggPopUp.PopUp(aPoint.x, aPoint.y);
  376. end;
  377.  
  378. function TDSSQueryEditor.AddSummary(sType: TDimFlags): Boolean;
  379. var
  380.   i, j: Integer;
  381.   DM: TQueryDim;
  382.   EWarning: string;  
  383. begin
  384.   EWarning := '';
  385.   Result := False;
  386.   with FieldList do
  387.     for I := 0 to Items.Count - 1 do
  388.     begin
  389.       if Selected[I] then
  390.       begin
  391.         for J := 0 to fieldMap.count-1 do
  392.         begin
  393.           DM := fieldMap[J];
  394.           if (FieldListDisplay(DM) = Items.STRINGS[I]) then
  395.           begin
  396.             try
  397.               if AddNewItem(stype,DM,'') then
  398.                 Result := True;
  399.             except
  400.               on E: EAddWarning do
  401.               begin
  402.                 EWarning := E.message;
  403.               end;
  404.               on E: exception do
  405.               begin
  406.                 if Result then
  407.                 begin
  408.                   mySQL := FQParse.SQLString;
  409.                   UpdateDimLists;
  410.                   UpdateSQLBox;
  411.                 end;
  412.                 raise;
  413.               end;
  414.             end;
  415.           end;
  416.         end;
  417.       end;
  418.     end;
  419.   if Result then
  420.   begin
  421.     mySQL := fQParse.SQLString;
  422.     UpdateDimLists;
  423.     UpdateSQLBox;
  424.   end;
  425.   if (EWarning <> '') then
  426.     raise EAddWarning.create(EWarning);
  427. end;
  428.  
  429. procedure TDSSQueryEditor.RemoveButtonClick(Sender: TObject);
  430. var
  431.   i, j: Integer;
  432.   DM: TQueryDim;
  433.   bChanged: Boolean;
  434.   reSelect: Integer;
  435. label
  436.   FastExit;
  437. begin
  438.   bChanged := False;
  439.   reSelect := -1;
  440.   with ActiveDimList do
  441.   begin
  442.     for I := 0 to Items.Count - 1 do
  443.     begin
  444.       if Selected[I] then
  445.       begin
  446.         if (Reselect = -1) then Reselect := I;
  447.         for J := 0 to myMap.count-1 do
  448.         begin
  449.           DM := myMap[j];
  450.           if (DM.FieldName = Items.STRINGS[I]) then
  451.           begin
  452.             try
  453.               RemoveDimensionItem(fQParse, myMap, J);
  454.               DM.free;
  455.               bChanged := True;
  456.               Break;
  457.             except
  458.               showmessage(SRemoveFieldError);
  459.             end;
  460.             goto FastExit;
  461.           end;
  462.         end;
  463.       end;
  464.     end;
  465.   end;
  466.   FastExit:
  467.     if bChanged then
  468.     begin
  469.       mySQL := fQParse.SQLString;
  470.       UpdateDimLists;
  471.       UpdateSQLBox;
  472.  
  473.       if (reselect >= ActiveDimList.Items.count) then
  474.         reselect := ActiveDimList.Items.count-1;
  475.       if (reselect >= 0) then
  476.       begin
  477.         ActiveDimList.selected[reselect] := True;
  478.         RemoveButton.enabled := True;
  479.       end;
  480.     end;
  481. end;
  482.  
  483. procedure TDSSQueryEditor.RemoveAggClick(Sender: TObject);
  484. var
  485.   i, j, k: Integer;
  486.   DM: TQueryDim;
  487.   reSelect: Integer;
  488.   bChanged: Boolean;
  489. label
  490.   FastExit;
  491. begin
  492.   reselect := -1;
  493.   with SummaryList do
  494.   begin
  495.     bChanged := False;
  496.     for I := 0 to Items.Count - 1 do
  497.     begin
  498.       if (Reselect = -1) then Reselect := I;
  499.       if Selected[I] then
  500.       begin
  501.         for J := 0 to myMap.count-1 do
  502.         begin
  503.           DM := myMap[j];
  504.           if (DM.FieldName = Items.STRINGS[I]) then
  505.           begin
  506.             try
  507.               RemoveDimensionItem(fQParse, myMap, J);
  508.               if (DM.DimensionType <> dimDimension) then
  509.               begin
  510.                 for k := 0 to fieldMap.count-1 do
  511.                 begin
  512.                   if (fieldMap[k].FieldName = DM.FieldName) then
  513.                     Break;
  514.                 end;
  515.                 if (k = fieldMap.count) and (AnsiUpperCase(DM.Name) <> sCountStar) then
  516.                 begin
  517.                   fieldMap.Add.Assign(DM);
  518.                   UpdateFieldList;
  519.                 end;
  520.               end;
  521.               DM.free;
  522.               bChanged := True;
  523.               Break;
  524.             except
  525.               showmessage(SRemoveFieldError);
  526.             end;
  527.             goto FastExit;
  528.           end;
  529.         end;
  530.       end;
  531.     end;
  532.   end;
  533.   FastExit:
  534.     if bChanged then
  535.     begin
  536.       mySQL := fQParse.SQLString;
  537.       UpdateDimLists;
  538.       if (reselect >= SummaryList.Items.count) then
  539.         reselect := SummaryList.Items.count-1;
  540.       if (reselect >= 0) then
  541.       begin
  542.         SummaryList.selected[reselect] := True;
  543.         RemoveAgg.enabled := True;
  544.       end;
  545.       UpdateSQLBox;
  546.     end;
  547. end;
  548.  
  549. procedure TDSSQueryEditor.FieldListClick(Sender: TObject);
  550. begin
  551.   if (FieldList.SelCount >= 0) then
  552.   begin
  553.     AddButton.enabled := True;
  554.     AddAgg.enabled := True;
  555.     ListBoxUnSelect(SummaryList);
  556.     ListBoxUnSelect(ActiveDimList);
  557.     RemoveButton.enabled := False;
  558.     RemoveAgg.enabled := False;
  559.   end;
  560. end;
  561.  
  562. procedure TDSSQueryEditor.ActiveDimListClick(Sender: TObject);
  563. begin
  564.   ListBoxUnSelect(SummaryList);
  565.   ListBoxUnSelect(FieldList);
  566.   AddButton.enabled := False;
  567.   AddAgg.enabled := False;
  568.   RemoveButton.enabled := (ActiveDimList.SelCount >= 0);
  569. end;
  570.  
  571. procedure TDSSQueryEditor.SummaryListClick(Sender: TObject);
  572. begin
  573.   ListBoxUnSelect(ActiveDimList);
  574.   ListBoxUnSelect(FieldList);
  575.   AddButton.enabled := False;
  576.   AddAgg.enabled := False;
  577.   RemoveButton.enabled := False;
  578.   RemoveAgg.enabled := (SummaryList.SelCount >= 0);
  579. end;
  580.  
  581. procedure TDSSQueryEditor.ListBoxUnSelect(aListBox: TListBox);
  582. var
  583.   i: Integer;  
  584. begin
  585.   with aListBox do
  586.   begin
  587.     for i := 0 to items.count-1 do
  588.     begin
  589.       if selected[i] then selected[i] := False;
  590.     end;
  591.   end;
  592. end;
  593.  
  594. function TDSSQueryEditor.FieldListDisplay(Map: TQueryDim): string;
  595. begin
  596.   Result := Map.FieldName;
  597.   if Map.active then Result := '*' + Result;
  598. end;
  599.  
  600. procedure TDSSQueryEditor.AddCountStar;
  601. var
  602.   DM: TQueryDim;
  603. begin
  604.   DM := fieldMap.Add;
  605.   try
  606.     DM.BaseName := '*';
  607.     DM.FieldName := '*';
  608.     DM.FieldType := ftString;
  609.     AddNewItem(dimCount, DM, sCountStar);
  610.   finally
  611.     DM.Free;
  612.   end;
  613.   mySQL := fQParse.SQLString;
  614.   UpdateDimLists;
  615.   UpdateSQLBox;
  616. end;
  617.  
  618. procedure TDSSQueryEditor.RemoveCountStar;
  619. var
  620.   j: Integer;
  621.   DM: TQueryDim;
  622. begin
  623.   for J := 0 to myMap.count-1 do
  624.   begin
  625.     DM := myMap[j];
  626.     if (AnsiUpperCase(DM.Name) = sCountStar) then
  627.     begin
  628.       try
  629.         RemoveDimensionItem(fQParse, myMap, J);
  630.         DM.free;
  631.         Break;
  632.       except
  633.         showmessage(SRemoveFieldError);
  634.         Exit;
  635.       end;
  636.     end;
  637.   end;
  638.   mySQL := fQParse.SQLString;
  639.   UpdateDimLists;
  640.   UpdateSQLBox;
  641. end;
  642.  
  643. function TDSSQueryEditor.AddNewItem(sType: TDimFlags; DM: TQueryDim; Name: string): Boolean;
  644. var
  645.   NewDM: TQueryDim;
  646.   iPos, i: Integer;
  647. begin
  648.   Result := False;
  649.   { Check to see if it exists already }
  650.   if myMap.alreadyExists(DM.BaseName, stype) then
  651.     raise EAddWarning.create(GetAggName(sType, DM.BaseName) + SAddFieldExists);
  652.   if not isAggValid(stype, DM.FieldType) then
  653.   begin
  654.     if (stype = dimDimension) then
  655.       raise EAddError.create(DM.BaseName + sDimTypeNotALlowed)
  656.     else
  657.       raise EAddError.create(GetAggName(stype, DM.BaseName) + sAggTypeNotALlowed);
  658.   end;
  659.   NewDM := myMap.Add;
  660.   if not assigned(NewDM) then Exit;
  661.   iPos := myMap.count-1;
  662.   if (sType = dimDimension) then  { add new dimension before summaries }
  663.   begin
  664.     for i := 0 to myMap.count-2 do
  665.     begin
  666.       if (myMap[i].dimensionType <> dimDimension) then
  667.       begin
  668.         iPos := i;
  669.         Break;
  670.       end;
  671.     end;
  672.   end;
  673.   if (NewDM.Index <> iPos) then NewDM.Index := iPos;
  674.   NewDM.fieldname := DM.FieldName;
  675.   NewDM.basename := DM.baseName;
  676.   NewDM.DimensionType := sType;
  677.   NewDM.Name := GetAggName(SType, DM.Name);
  678.   NewDM.active := True;
  679.   try
  680.    AddDimensionItem(fQParse, myMap, iPos, Name);
  681.   except
  682.     on E: Exception do
  683.     begin
  684.       NewDM.free;
  685.       raise;
  686.     end;
  687.   end;
  688.   Result := True;
  689. end;
  690.  
  691. procedure TDSSQueryEditor.Sum1Click(Sender: TObject);
  692. begin
  693.   AddSummary(dimSum);
  694. end;
  695.  
  696. procedure TDSSQueryEditor.Count1Click(Sender: TObject);
  697. begin
  698.   AddSummary(dimCount);
  699. end;
  700.  
  701. procedure TDSSQueryEditor.OKButtonClick(Sender: TObject);
  702. var
  703.   anError: TQueryError;
  704.   aMessage: string;
  705.   dSQL: string;
  706. begin
  707.   try
  708.     dSQL := fQParse.GetDialectSQLString;
  709.     anError := fQParse.isLegal;
  710.   except
  711.     on exception do
  712.     begin
  713.       anError := tqeNotInitialized;
  714.     end;
  715.   end;
  716.   if (anError <> tqeOK) then
  717.   begin
  718.     case anError of
  719.       tqeNoDimensions : aMessage := SNoDims;
  720.       tqeNoAggs       : aMessage := SNoAggs;
  721.       tqeNotGrouped   : aMessage := SGroupsMissing;
  722.       else
  723.         aMessage := SQueryIllegal;
  724.     end;
  725.     if (MessageDlg(aMessage + ' ' + sWantToExit, mtConfirmation, [mbYes, mbNo], 0) <> 6) then
  726.     begin
  727.       updatelists;
  728.       Exit;
  729.     end;
  730.   end;
  731.   myQuery.active := False;
  732.   myQuery.SQL.text := dSQL;
  733.   myQuery.DatabaseName := myAlias;
  734.   UpdateDesigner(myQuery);
  735.   Close;
  736. end;
  737.  
  738. procedure TDSSQueryEditor.VQBClick(Sender: TObject);
  739. var
  740.   bNoDataBase: Boolean;
  741.   SaveSQL: string;
  742. begin
  743.   if not GQELoaded then Exit;
  744.   bNoDataBase := myAlias = '';
  745.   if (vqbQuery = nil) then vqbQuery := TQuery.Create(myQuery);
  746.   if (vqbQuery.DataBaseName <> myALias) then
  747.   begin
  748.     vqbQuery.DataBaseName := myAlias;
  749.     vqbQuery.SQL.text := '';
  750.   end;
  751.   SaveSQL := vqbQuery.Text;
  752.   BuildQuery(vqbQuery);
  753.   if bNoDataBase then
  754.   begin
  755.     if (VQBQuery.DataBaseName = '') then Exit;
  756.     SetDataBaseName(vqbquery.DataBaseName);
  757.   end;
  758.   if (SaveSQL <> vqbQuery.SQL.Text) then
  759.   begin
  760.     try
  761.       bAllFields := False;
  762.       ProcessNewQuery(VQBQuery.SQL.Text);
  763.       if not bisOK then
  764.       begin
  765.         fQParse.DeleteProjectors;
  766.         mySQL := fQParse.SQLString;
  767.         myMap.Clear;
  768.         updatelists;
  769.       end;
  770.     except
  771.       on E: exception do
  772.       begin
  773.         ShowMessage(E.message);
  774.       end;
  775.     end;
  776.   end;
  777.   SetQueryEditState(False);
  778. end;
  779.  
  780. procedure TDSSQueryEditor.ProcessNewQuery(newSQL: String);
  781. var
  782.   i: Integer;
  783.   anError: TQueryError; 
  784. begin
  785.   if CheckifStringNull(newSQL) or (myDB = nil) then
  786.   begin
  787.     mySQL := '';
  788.     bQueryLegal := False;
  789.     myMap.clear;
  790.     bisOK := False;
  791.     fieldMap.clear;
  792.     bAllFields := False;
  793.     bSQLChangeOff := False;
  794.     SetQueryEditState(False);
  795.     UpdateLists;
  796.     Exit;
  797.   end;
  798.   try
  799.     if bAllFields then
  800.     begin
  801.       fQParse.canDelete := True;
  802.       BuildDimensionMap(fQParse, myMap, newSQL);
  803.       fQParse.canDelete := False;
  804.       BuildMasterDimensionMap(fQParse, FieldMap);
  805.     end
  806.     else
  807.     begin
  808.       fQParse.canDelete := True;
  809.       anError := BuildDimensionMap(fQParse, FieldMap, newSQL);
  810.       bisOK := (anError = tqeOK);
  811.       for i := 0 to fieldMap.count-1 do
  812.         fieldMap[i].active := False;
  813.       myMap.Assign(FieldMap);
  814.       for i := 0 to MYMap.count-1 do
  815.         MYMap[i].active := True;
  816.     end;
  817.     mySQL := fQParse.SQLString;
  818.   except
  819.     on E: exception do
  820.     begin
  821.       bQueryLegal := False;
  822.       raise;
  823.     end;
  824.   end;
  825.   bQueryLegal := True;
  826.   SetQueryEditState(False);
  827.   updatelists;
  828.   UpdateTableName;
  829. end;
  830.  
  831. procedure TDSSQueryEditor.UpdateTableName;
  832. var
  833.   TableName: string;
  834.   i: Integer;
  835.   bFound: Boolean;
  836. begin
  837.   { Update the table dropdown } 
  838.   bFound := False;
  839.   if assigned(fQParse) and (fQParse.nTables = 1) then
  840.   begin
  841.     TableName := fQParse.TableName[0];
  842.     for i := 0 to TableCombo.Items.count-1 do
  843.     begin
  844.       if (TableCombo.Items[i] = TableName) then
  845.       begin
  846.         bTableNameEditing := True;
  847.         TableCombo.ItemIndex := i;
  848.         bFound := True;
  849.         Break;
  850.       end;
  851.     end;
  852.     if not bFound then
  853.     begin
  854.       bTableNameEditing := True;
  855.       TableCombo.ItemIndex := TableCombo.items.Add(TableName);
  856.     end;
  857.     bTableNameEditing := False;
  858.   end;
  859. end;
  860.  
  861. procedure TDSSQueryEditor.CancelQryModClick(Sender: TObject);
  862. begin
  863.   if not bQueryEditing then Exit;
  864.   ProcessNewQueryError(mySQL);
  865.   if OKButton.Enabled then OKButton.SetFocus;
  866. end;
  867.  
  868. procedure TDSSQueryEditor.ProcessNewQueryError(newSQL: string);
  869. begin
  870.   try
  871.     mySQL := newSQL;
  872.     ProcessNewQuery(mySQL);
  873.   except
  874.     on e: exception do
  875.     begin
  876.       ShowMessage(e.message);
  877.       myMap.clear;
  878.       fieldMap.clear;
  879.     end;
  880.   end;
  881.   SetQueryEditState(False);
  882.   updatelists;
  883. end;
  884.  
  885. procedure TDSSQueryEditor.ShowBoxChange(Sender: TObject);
  886. begin
  887.   if bQueryEditing then Exit;
  888.   if bSQLChangeOff then Exit;
  889.   SetQueryEditState(True);
  890. end;
  891.  
  892. procedure TDSSQueryEditor.SetQueryEditState(State: Boolean);
  893. var
  894.   dState: Boolean;
  895. begin
  896.   dState := assigned(myDb);
  897.   AddButton.enabled := False;
  898.   RemoveButton.enabled := False;
  899.   RemoveAgg.enabled := False;
  900.   AddAgg.enabled := False;
  901.   ShowBox.enabled := dState;
  902.   EditQry.enabled := dState;
  903.   TableCombo.enabled := dState;
  904.   OKButton.enabled := not state;
  905.   { save the old state to restore later if needed }
  906.   bQueryEditing := dState and state;
  907.   CancelQryMod.enabled := dState and state;
  908.   FieldList.enabled := dState and bQueryLegal and not state;
  909.   ActiveDimList.enabled := dState and bQueryLegal and not state;
  910.   SummaryList.enabled := dState and bQueryLegal and not state;
  911.   SelectAllFields.enabled := dState and bQueryLegal and not state;
  912.   CountStarAvg.enabled := dState and bQueryLegal and not state;
  913.   if bQueryEditing then
  914.     EditQry.caption := sEditDone
  915.   else
  916.     EditQry.caption := sEditQuery;
  917.   VQB.enabled := not state;
  918. end;
  919.  
  920. procedure TDSSQueryEditor.EditQryClick(Sender: TObject);
  921. var
  922.   aString: string;  
  923. begin
  924.   if bQueryEditing then
  925.   begin
  926.     aString := ShowBox.Lines.Text;
  927.     try
  928.       bAllFields := True;
  929.       ProcessNewQuery(aString);
  930.     except
  931.       on E: exception do
  932.       begin
  933.         ShowMessage(E.message);
  934.         bQueryEditing := True;
  935.         Exit;
  936.       end;
  937.     end;
  938.     SetQueryEditState(False);
  939.     updatelists;
  940.     if OKButton.Enabled then OKButton.SetFocus;
  941.   end
  942.   else
  943.   begin
  944.     if bSQLChangeOff then Exit;
  945.     SetQueryEditState(True);
  946.     if ShowBox.enabled then ShowBox.SetFocus;
  947.   end;
  948. end;
  949.  
  950. procedure TDSSQueryEditor.SelectAllFieldsClick(Sender: TObject);
  951. begin
  952.   if not assigned(myDB) then Exit;
  953.   bAllFields := not bAllFields;
  954.   ProcessNewQuery(mySQL);
  955. end;
  956.  
  957. procedure TDSSQueryEditor.FieldListDblClick(Sender: TObject);
  958. var
  959.   i, j: Integer;
  960.   DM: TQueryDim;
  961.   bChanged: Boolean;
  962.   EWarning: string;  
  963. begin
  964.   bChanged := False;
  965.   EWarning := '';
  966.   with FieldList do
  967.     for I := 0 to Items.Count - 1 do
  968.     begin
  969.       if Selected[I] then
  970.       begin
  971.         for J := 0 to fieldMap.count-1 do
  972.         begin
  973.           DM := fieldMap[J];
  974.           if FieldListDisplay(DM) = Items.STRINGS[I] then
  975.           begin
  976.             try
  977.               if AddNewItem(DM.DimensionType,DM,'') then
  978.                 bChanged := True;
  979.             except
  980.               on E: EAddWarning do
  981.               begin
  982.                 EWarning := E.message;
  983.               end;
  984.               on exception do
  985.               begin
  986.                 if bChanged then
  987.                 begin
  988.                   mySQL := FQParse.SQLString;
  989.                   UpdateDimLists;
  990.                   UpdateSQLBox;
  991.                 end;
  992.               raise;
  993.             end;
  994.           end;
  995.         end;
  996.       end;
  997.     end;
  998.   end;
  999.   if bChanged then
  1000.   begin
  1001.     mySQL := FQParse.SQLString;
  1002.     UpdateDimLists;
  1003.     UpdateSQLBox;
  1004.   end;
  1005.   if (EWarning <> '') then
  1006.     raise EAddWarning.create(EWarning);
  1007. end;
  1008.  
  1009. procedure TDSSQueryEditor.average1Click(Sender: TObject);
  1010. var
  1011.   EWarning: string;  
  1012. begin
  1013.   EWarning := '';
  1014.   try
  1015.     AddSummary(dimSum);
  1016.   except
  1017.     on E: EAddWarning do
  1018.     begin
  1019.       EWarning := E.message;
  1020.     end;
  1021.   end;
  1022.   if not CountStarAvg.checked then
  1023.   begin
  1024.     try
  1025.       AddSummary(dimCount);
  1026.     except
  1027.       on E: EAddWarning do
  1028.       begin
  1029.         EWarning := E.message;
  1030.       end;
  1031.     end;
  1032.   end;
  1033.   if (EWarning <> '') then
  1034.   begin
  1035.     if CountStarAvg.Checked then
  1036.       ShowMessage(SAddAvgStarWarning)
  1037.     else
  1038.       ShowMessage(SAddAvgWarning);
  1039.   end;
  1040. end;
  1041.  
  1042. procedure TDSSQueryEditor.ActiveDimListDragDrop(Sender, Source: TObject; X,
  1043.   Y: Integer);
  1044. begin
  1045.   if (source = FieldList) then
  1046.   begin
  1047.     AddButtonClick(Self);
  1048.   end;
  1049. end;
  1050.  
  1051. procedure TDSSQueryEditor.ActiveDimListDragOver(Sender, Source: TObject; X,
  1052.   Y: Integer; State: TDragState; var Accept: Boolean);
  1053. begin
  1054.   if (Source = FieldList) then
  1055.     Accept := True;
  1056. end;
  1057.  
  1058. procedure TDSSQueryEditor.FieldListDragOver(Sender, Source: TObject; X,
  1059.   Y: Integer; State: TDragState; var Accept: Boolean);
  1060. begin
  1061.   if (Source = ActiveDimList) or (Source = SummaryList) then
  1062.     Accept := True;
  1063. end;
  1064.  
  1065. procedure TDSSQueryEditor.SummaryListDragOver(Sender, Source: TObject; X,
  1066.   Y: Integer; State: TDragState; var Accept: Boolean);
  1067. begin
  1068.   if (source = FieldList) then
  1069.     Accept := True;
  1070. end;
  1071.  
  1072. procedure TDSSQueryEditor.FieldListDragDrop(Sender, Source: TObject; X,
  1073.   Y: Integer);
  1074. begin
  1075.   if (Source = ActiveDimList) then RemoveButtonClick(Self);
  1076.   if (Source = SummaryList) then RemoveAggClick(Self);
  1077. end;
  1078.  
  1079. procedure TDSSQueryEditor.SummaryListDragDrop(Sender, Source: TObject; X,
  1080.   Y: Integer);
  1081. begin
  1082.   if (Source = FieldList) then AddAggClick(Self);
  1083. end;
  1084.  
  1085. procedure TDSSQueryEditor.FieldListKeyPress(Sender: TObject;
  1086.   var Key: Char);
  1087. begin
  1088.   if (Key = Chr(13)) then
  1089.   begin
  1090.     AddButtonClick(Self);
  1091.     key := chr(0);
  1092.   end;
  1093. end;
  1094.  
  1095. procedure TDSSQueryEditor.ShowBoxKeyPress(Sender: TObject; var Key: Char);
  1096. begin
  1097.   if bQueryEditing then
  1098.   begin
  1099.     if (key = chr(27)) then
  1100.     begin
  1101.       CancelQryModClick(Self);
  1102.       key := chr(0);
  1103.     end
  1104.     else
  1105.     begin
  1106.     end;
  1107.   end;
  1108. end;
  1109.  
  1110. procedure TDSSQueryEditor.ActiveDimListKeyPress(Sender: TObject;
  1111.   var Key: Char);
  1112. begin
  1113.   if (Key = Chr(13)) then
  1114.   begin
  1115.     RemoveButtonClick(Self);
  1116.     key := chr(0);
  1117.   end;
  1118. end;
  1119.  
  1120. procedure TDSSQueryEditor.SummaryListKeyPress(Sender: TObject;
  1121.   var Key: Char);
  1122. begin
  1123.   if (Key = Chr(13)) then
  1124.   begin
  1125.     RemoveAggClick(Self);
  1126.     key := chr(0);
  1127.   end;
  1128. end;
  1129.  
  1130. procedure TDSSQueryEditor.PagerChanging(Sender: TObject;
  1131.   var AllowChange: Boolean);
  1132. begin
  1133.   if (Pager.ActivePage.Name = 'Query') and bQueryEditing then
  1134.   begin
  1135.     EditQryClick(Self);
  1136.     if bQueryEditing then AllowChange := False;
  1137.   end;
  1138. end;
  1139.  
  1140. procedure TDSSQueryEditor.SetTableName(TableName: string);
  1141. var
  1142.   anSQL: string;  
  1143. begin
  1144.   if not CheckifStringNull(TableName) then
  1145.   begin
  1146.     if BQueryLegal and assigned(fQParse) and (fQParse.nTables = 1) then
  1147.       if (TableName = fQParse.TableName[0]) then Exit;
  1148.     anSQL := 'Select From ' + TableName;
  1149.     bAllFields := True;
  1150.     try
  1151.       ProcessNewQuery(anSQL);
  1152.     except
  1153.       fQParse.SQLString := '';
  1154.       fQParse.AddTable(TableName);
  1155.       anSQL := FQParse.SQLString;
  1156.       bAllFields := True;
  1157.       ProcessNewQuery(anSQL);
  1158.     end;
  1159.   end;
  1160. end;
  1161.  
  1162. procedure TDSSQueryEditor.SetDatabaseName(tAlias: string);
  1163. var
  1164.   tDB: TDataBase;
  1165.   bFound: Boolean;
  1166.   i: Integer;  
  1167. begin
  1168.   if not CheckIfStringNull(tAlias) then
  1169.   begin
  1170.     tDB := myQuery.DBSession.OpenDataBase(tAlias);
  1171.     if assigned (tDB) then
  1172.     begin
  1173.       myAlias := tAlias;
  1174.       if (myDB <> nil) then
  1175.       begin
  1176.         myQuery.DBSession.CloseDataBase(myDB);
  1177.         myDB := nil;
  1178.       end;
  1179.       myDb := tDB;
  1180.       myDB.connected := True;
  1181.       if not assigned(fQParse) then fQParse := TXTabQuery.create;
  1182.       fQParse.canDelete := True;
  1183.       fQParse.DBHandle := myDB.Handle;
  1184.       UpdateTableList;
  1185.       bAllFields := True;
  1186.       ProcessNewQuery('');
  1187.       SetQueryEditState(False);
  1188.       bFound := False;
  1189.       DataBaseCombo.text := tAlias;
  1190.       for i := 0 to DataBaseCombo.items.count-1 do
  1191.       begin
  1192.         if (tAlias = DataBaseCombo.items[i]) then
  1193.           bFound := True;
  1194.       end;
  1195.       if not bFound then DataBaseCombo.items.Add(tAlias);
  1196.     end;
  1197.   end;
  1198. end;
  1199.  
  1200. procedure TDssQueryEditor.UpdateTableList;
  1201. begin
  1202.   TableCombo.Clear;
  1203.   if not CheckifStringNull(myAlias) then
  1204.     myQuery.DBSession.GetTableNames(Myalias, '', True, False, TableCombo.items);
  1205. end;
  1206.  
  1207. procedure TDssQueryEditor.UpdateDataBaseList;
  1208. begin
  1209.   myQuery.DBSession.GetDatabaseNames(DatabaseCombo.items);
  1210. end;
  1211.  
  1212. procedure TDSSQueryEditor.DatabaseComboChange(Sender: TObject);
  1213. begin
  1214.   if bDataBaseEditing then
  1215.     bDataBaseChanged := True
  1216.   else
  1217.     SetDataBaseName(DatabaseCombo.text);
  1218. end;
  1219.  
  1220. procedure TDSSQueryEditor.DatabaseComboExit(Sender: TObject);
  1221. begin
  1222.   if bDataBaseChanged then
  1223.   begin
  1224.     try
  1225.       SetDataBaseName(DataBaseCombo.Text);
  1226.     except
  1227.       on e: exception do
  1228.       begin
  1229.         ShowMessage(e.message);
  1230.         if DataBaseCombo.enabled then
  1231.           DataBaseCombo.SetFocus;
  1232.       end;
  1233.     end;
  1234.   end;
  1235.   bDataBaseEditing := False;
  1236.   bDataBaseChanged := False;
  1237. end;
  1238.  
  1239. procedure TDSSQueryEditor.DatabaseComboKeyDown(Sender: TObject;
  1240.   var Key: Word; Shift: TShiftState);
  1241. begin
  1242.   bDataBaseEditing := True;
  1243.   TableCombo.enabled := True;
  1244. end;
  1245.  
  1246. procedure TDSSQueryEditor.DatabaseComboKeyPress(Sender: TObject;
  1247.   var Key: Char);
  1248. begin
  1249.   if (Key = Char(13)) then
  1250.   begin
  1251.     DataBaseComboExit(Self);
  1252.     Key := Char(0);
  1253.   end;
  1254. end;
  1255.  
  1256. procedure TDSSQueryEditor.TableComboKeyDown(Sender: TObject; var Key: Word;
  1257.   Shift: TShiftState);
  1258. begin
  1259.   bTableNameEditing := True;
  1260. end;
  1261.  
  1262. procedure TDSSQueryEditor.TableComboKeyPress(Sender: TObject;
  1263.   var Key: Char);
  1264. begin
  1265.   if (Key = Char(13)) then
  1266.   begin
  1267.     TableComboExit(Self);
  1268.     Key := Char(0);
  1269.   end;
  1270. end;
  1271.  
  1272. procedure TDSSQueryEditor.TableComboExit(Sender: TObject);
  1273. begin
  1274.   if bTableNameChanged then
  1275.   begin
  1276.     try
  1277.       SetTableName(TableCombo.Text);
  1278.       SetQueryEditState(False);
  1279.     except
  1280.       on e: exception do
  1281.       begin
  1282.         ShowMessage(e.message);
  1283.         TableCombo.SetFocus;
  1284.       end;
  1285.     end;
  1286.   end;
  1287.   bTableNameEditing := False;
  1288.   bTableNameChanged := False;
  1289. end;
  1290.  
  1291. procedure TDSSQueryEditor.TableComboChange(Sender: TObject);
  1292. begin
  1293.   if bTableNameEditing then
  1294.     bTableNameChanged := True
  1295.   else if not CheckifStringNull(TableCombo.text) then
  1296.   begin
  1297.     SetTableName(TableCombo.text);
  1298.   end;
  1299. end;
  1300.  
  1301. procedure TDSSQueryEditor.HelpButtonClick(Sender: TObject);
  1302. begin
  1303.   Application.HelpContext(hcDDecisionQueryEditor);
  1304. end;
  1305.  
  1306. procedure TDSSQueryEditor.CountStarAvgClick(Sender: TObject);
  1307. begin
  1308.   if bStarAvgChanging then Exit;
  1309.   if CountStarAvg.Checked then
  1310.     AddCountStar
  1311.   else
  1312.     RemoveCountStar;
  1313. end;
  1314.  
  1315. end.
  1316.